\ The Rest is Silence 30Jun86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Pre-Compile 25Jun86gemONLY FORTH ALSO DEFINITIONS DOS ' NOOP IS HEADER FENCE OFF FORGET OUT : NLOAD CR .S (LOAD) ; ' NLOAD IS LOAD WARNING OFF 3 21 THRU ( The Meta Compiler ) ONLY FORTH DEFINITIONS ALSO CR .( Meta Compiler Loaded ) FROM KERNEL.BLK 1 LOAD \ Vocabulary Helpers 06Jan86gemONLY FORTH ALSO VOCABULARY META META ALSO META DEFINITIONS VARIABLE DP-T : [FORTH] FORTH ; IMMEDIATE : [META] META ; IMMEDIATE : [ASSEMBLER] ASSEMBLER ; IMMEDIATE : SWITCH (S -- ) NOOP ( Context ) NOOP ( Current ) DOES> DUP @ CONTEXT @ SWAP CONTEXT ! OVER ! 2+ DUP @ CURRENT @ SWAP CURRENT ! SWAP ! ; SWITCH ( Redefine itself ) \ Memory Access Words 06Jan86gem0 CONSTANT TARGET-ORIGIN : THERE (S taddr -- addr ) TARGET-ORIGIN + ; : C@-T (S taddr -- char ) THERE C@ ; : @-T (S taddr -- n ) THERE @ ; : C!-T (S char taddr -- ) THERE C! ; : !-T (S n taddr -- ) THERE ! ; : HERE-T (S -- taddr ) DP-T @ ; : ALLOT-T (S n -- ) DP-T +! ; : C,-T (S char -- ) HERE-T C!-T 1 ALLOT-T ; : ,-T (S n -- ) HERE-T !-T 2 ALLOT-T ; : S,-T (S addr len -- ) 0 ?DO COUNT C,-T LOOP DROP ; : ALIGN (S -- ) HERE-T 1 AND IF BL C,-T THEN ; \ Define Symbol Table Vocabularies 06Jan86gemVOCABULARY TARGET VOCABULARY TRANSITION VOCABULARY FORWARD VOCABULARY USER ONLY DEFINITIONS FORTH ALSO META ALSO : META META ; : TARGET TARGET ; : TRANSITION TRANSITION ; : FORWARD FORWARD ; : USER USER ; : ASSEMBLER ASSEMBLER ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Control Structures 06Jan86gem: ?>MARK (S -- addr f ) HERE-T TRUE 0 ,-T ; : ?>RESOLVE (S addr f -- ) ?CONDITION HERE-T SWAP !-T ; : ?<MARK (S -- addr f ) HERE-T TRUE ; : ?<RESOLVE (S addr f -- ) ?CONDITION ,-T ; \ 68000 Meta Assembler 06Jan86gemASSEMBLER ALSO DEFINITIONS : M?>MARK (S -- addr f ) HERE-T TRUE ; : M?>RESOLVE (S addr f -- ) ?CONDITION HERE-T OVER - [FORTH] SWAP 1- C!-T ; : M?<MARK (S -- addr f ) HERE-T TRUE ; : M?<RESOLVE (S addr f -- ) ?CONDITION HERE-T - HERE-T 1- C!-T ; ' C,-T IS C, ' ,-T IS , ' M?>MARK IS ?>MARK ' M?>RESOLVE IS ?>RESOLVE ' M?<MARK IS ?<MARK ' M?<RESOLVE IS ?<RESOLVE ONLY FORTH ALSO META ALSO DEFINITIONS \ Meta Compiler Vocabulary Manipulators 06Jan86gem: MAKE-CODE (S PFA -- ) @ ,-T ; : LABEL (S -- ) ASSEMBLER DEFINITIONS HERE-T CONSTANT [ ASSEMBLER ] WORD ; : IN-TARGET (S -- ) ONLY TARGET DEFINITIONS ; : IN-TRANSITION (S -- ) ONLY FORWARD ALSO TARGET DEFINITIONS ALSO TRANSITION ; : IN-META (S -- ) ONLY FORTH ALSO META DEFINITIONS ALSO ; : IN-FORWARD (S -- ) FORWARD DEFINITIONS ; \ Meta Compiler Forward Reference Linking 06Jan86gem: LINK-BACKWARDS (S PFA -- ) HERE-T OVER @ ,-T SWAP ! ; : RESOLVED? (S pfa -- f ) 2+ @ ; : FORWARD-CODE (S pfa -- ) DUP RESOLVED? IF MAKE-CODE ELSE LINK-BACKWARDS THEN ; : FORWARD: (S -- ) SWITCH FORWARD DEFINITIONS CREATE SWITCH 0 , 0 , DOES> FORWARD-CODE ; \ Create Headers in Target Image 06Jan86gemVARIABLE WIDTH 31 WIDTH ! VARIABLE LAST-T VARIABLE CONTEXT-T VARIABLE CURRENT-T : HASH (S str-addr voc-addr -- thread ) SWAP 1+ C@ 3 AND 2* + ; : HEADER (S -- ) BL WORD C@ 1+ WIDTH @ MIN ?DUP IF ALIGN BLK @ 4096 + ,-T ( Lay down view field ) HERE CURRENT-T @ HASH DUP @-T ,-T HERE-T 2- SWAP !-T HERE-T HERE ROT S,-T ALIGN DUP LAST-T ! 128 SWAP THERE CSET 128 HERE-T 1- THERE CSET THEN ; \ Meta Compiler Create Target Image 06Jan86gem: TARGET-CREATE (S -- ) >IN @ HEADER >IN ! IN-TARGET CREATE IN-META HERE-T , TRUE , DOES> MAKE-CODE ; : RECREATE (S -- ) >IN @ TARGET-CREATE >IN ! ; : CODE (S -- ) TARGET-CREATE HERE-T 2+ ,-T ASSEMBLER !CSP [ ASSEMBLER ] WORD ; ASSEMBLER ALSO DEFINITIONS : END-CODE IN-META ?CSP ; META IN-META \ Force compilation of target & forward words 06Jan86gem: 'T (S -- cfa ) CONTEXT @ TARGET DEFINED ROT CONTEXT ! 0= ?MISSING ; : [TARGET] (S -- ) 'T , ; IMMEDIATE : 'F (S -- cfa ) CONTEXT @ FORWARD DEFINED ROT CONTEXT ! 0= ?MISSING ; : [FORWARD] (S -- ) 'F , ; IMMEDIATE \ Meta Compiler Branching & Defining Words 06Jan86gem: T: (S -- ) SWITCH TRANSITION DEFINITIONS CREATE SWITCH ] DOES> >R ; : T; (S -- ) SWITCH TRANSITION DEFINITIONS [COMPILE] ; SWITCH ; IMMEDIATE : DIGIT? (S CHAR -- F ) BASE @ DIGIT NIP ; : PUNCT? (S CHAR -- F ) ASCII . OVER = SWAP ASCII - OVER = SWAP ASCII / OVER = SWAP DROP OR OR ; : NUMERIC? (S ADDR LEN -- F ) DUP 1 = IF DROP C@ DIGIT? EXIT THEN 1 -ROT 0 ?DO DUP C@ DUP DIGIT? SWAP PUNCT? OR ROT AND SWAP 1+ LOOP DROP ; \ Meta Compiler Transition Words 06Jan86gemT: ( [COMPILE] ( T; T: (S [COMPILE] (S T; T: \ [COMPILE] \ T; : STRING,-T (S -- ) ASCII " PARSE DUP C,-T S,-T ALIGN ; FORWARD: <(.")> T: ." [FORWARD] <(.")> STRING,-T T; FORWARD: <(")> T: " [FORWARD] <(")> STRING,-T T; FORWARD: <(ABORT")> T: ABORT" [FORWARD] <(ABORT")> STRING,-T T; \ Meta Compiler Defining Words 06Jan86gemFORWARD: <VARIABLE> : CREATE RECREATE [FORWARD] <VARIABLE> HERE-T CONSTANT ; : VARIABLE (S -- ) CREATE 0 ,-T ; FORWARD: <DEFER> : DEFER (S -- ) TARGET-CREATE [FORWARD] <DEFER> 0 ,-T ; \ Meta Compiler Defining Words 06Jan86gemFORTH VARIABLE #USER-T META ALSO USER DEFINITIONS : ALLOT (S n -- ) #USER-T +! ; FORWARD: <USER-VARIABLE> : VARIABLE (S -- ) SWITCH RECREATE [FORWARD] <USER-VARIABLE> #USER-T @ DUP ,-T 2 ALLOT META DEFINITIONS CONSTANT SWITCH ; FORWARD: <USER-DEFER> : DEFER (S -- ) SWITCH TARGET-CREATE [FORWARD] <USER-DEFER> SWITCH #USER-T @ ,-T 2 ALLOT ; ONLY FORTH ALSO META ALSO DEFINITIONS \ Meta Compiler Transition Words 06Jan86gemFORTH VARIABLE VOC-LINK-T META FORWARD: <VOCABULARY> : VOCABULARY (S -- ) RECREATE [FORWARD] <VOCABULARY> HERE-T #THREADS 0 DO 0 ,-T LOOP HERE-T VOC-LINK-T @ ,-T VOC-LINK-T ! CONSTANT DOES> @ CONTEXT-T ! ; : IMMEDIATE (S -- ) WIDTH @ IF ( Headers present? ) 64 ( Precedence Bit ) LAST-T @ THERE CSET THEN ; \ Meta Compiler Transition Words 06Jan86gemFORWARD: <(;USES)> FORTH VARIABLE STATE-T META T: ;USES (S -- ) [FORWARD] <(;USES)> IN-META ASSEMBLER !CSP STATE-T OFF T; T: [COMPILE] 'T EXECUTE T; FORWARD: <(IS)> T: IS [FORWARD] <(IS)> T; : IS 'T >BODY @ >BODY !-T ; \ Display an unformatted Symbol Table 06Jan86gem: .SYMBOLS (S -- ) BASE @ HEX CR TARGET CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE 4 LARGEST DUP WHILE TUCK @ SWAP ! L>NAME DUP C@ 31 AND TUCK 5 + ?LINE DUP NAME> >BODY @ 0 4 D.R SPACE .ID 16 SWAP - SPACES KEY? IF BASE ! EXIT THEN REPEAT 2DROP BASE ! IN-META ; \ Meta Compiler Resolve Forward References 06Jan86gem: .UNRESOLVED (S -- ) FORWARD CONTEXT @ HERE #THREADS 2* CMOVE BEGIN HERE #THREADS LARGEST DUP WHILE ?CR DUP L>NAME NAME> >BODY RESOLVED? 0= IF DUP L>NAME .ID THEN @ SWAP ! REPEAT 2DROP IN-META ; : FIND-UNRESOLVED (S -- cfa f ) 'F DUP >BODY RESOLVED? ; : RESOLVE (S taddr cfa -- ) >BODY 2DUP TRUE OVER 2+ ! @ BEGIN DUP WHILE 2DUP @-T -ROT SWAP !-T REPEAT 2DROP ! ; : RESOLVES (S taddr -- ) FIND-UNRESOLVED IF >NAME .ID ." Already Resolved" DROP ELSE RESOLVE THEN ; \ Interpretive words for Meta 06Jan86gem: H: [COMPILE] : ; H: ' 'T >BODY @ ; H: , ,-T ; H: C, C,-T ; H: HERE HERE-T ; H: ALLOT ALLOT-T ; H: DEFINITIONS DEFINITIONS CONTEXT-T @ CURRENT-T ! ; \ The Rest is Silence 06Jan86gem************************************************************* ************************************************************* *** *** *** Please direct all questions, comments, and *** *** miscellaneous personal abuse to: *** *** *** *** Henry Laxen or Michael Perry *** *** 1259 Cornell Avenue 1125 Bancroft Way *** *** Berkeley, California Berkeley, California *** *** 94706 94702 *** *** *** ************************************************************* ************************************************************* \ Load Screen for Pre-Compile 06Jan86gemMeta Compiling is a term to describe the process of generating a Forth system by compiling itself. It is similar in idea to the ordinary notion of compiling in Forth, but has some important differences. First the code that is generated by the Meta Compiler is generally not immediately executable.This may be for a variety of reasons, such as that the object code generated physically resides at a different address from where it must be to execute correctly. Also, it is possible through Meta Compilation to generate a Forth System for a totally different CPU than the one the Meta Compiler is running on. In such a case, the object code of course is not executable on the Host System. This Screen is the load screen for the Meta Compiler itself. The purpose of this section of the Meta Compiler is to compile Code Words correctly. \ Target System Setup 06Jan86gem Make Room for HOST definitions Set up the address where Target Compiled Code begins Set up the address where the Target Headers begin Set up the HOST address where Target Image resides Load the Source Screens that define the System Save the System as a CP/M file, ready to be executed \ Vocabulary Helpers 06Jan86gem META The Meta Compiler Environment, many redefintions DP-T The dictionary Pointer while meta compiling [FORTH] For convenience, an immediate version [META] For convenience, an immediate version SWITCH Exchange the saved values of CONTEXT and CURRENT with themselves. This should be used in pairs, and is only really meaningful in the second occurance. Its purpose is to save and restore the CONTEXT and CURRENT vocabularies. Following the first occurance you should invoke a vocabulary and perhaps DEFINITIONS. \ Memory Access Words 06Jan86gemTARGET-ORIGIN The Offset where the Target Image resides THERE Map a Target address to a Host address C@-T Fetch a byte at the given Target address @-T Fetch a word at the given Target address C!-T Store a byte at the given Target address !-T Store a word at the given Target address HERE-T Target address of next available dictionary byte ALLOT-T Allocate more space in the Target dictionary C,-T Add a byte to the Target dictionary ,-T Add a word to the Target dictionary S,-T Add a string to the Target dictionary ALIGN Makes the dictionary even. \ Define Symbol Table Vocabularies 06Jan86gemTARGET The symbol table for Target definitions TRANSITION Holds special case compiling words, like ." and [ FORWARD Holds all forward references, not neccessary but nice USER Holds USER version of defining words We add all of the vocabulary names to the ONLY vocabulary so that they are always accessible. This is mainly a convienence during debugging, when something fails and we need to look at different words in various vocabularies to figure out what is going on. Now we are guaranteed that we can reference all of the vocabularies inside META without standing on our heads. \ 68000 Meta Assembler 06Jan86gem?>MARK Set up for a forward branch. ?>RESOLVE Resolve a forward branch. ?<MARK Set up for a backwards branch. ?<RESOLVE Resolve a backwards branch. Because the following words are DEFERRED in the ASSEMBLER, we can redefine them in the Meta Compiler and use the exact same assembler we were using before. This is very convenient since it saves time and space. In fact, because the assembling portions of the asssember are deferred, we can use this same Assembler to do target assembly at a totally different origin. \ Meta Compiler Vocabulary Manipulators 06Jan86gemMAKE-CODE Take the code field pointed to and compile it in the Target LABEL Remember the current Target address and assign it a name. IN-TARGET Search only the Symbol Table. IN-TRANSITION Search TRANSITON TARGET and FORWARD in that order. IN-META The normal environment when interpreting in Meta. IN-FORWARD Used when a word is undefined and compiled on the fly. \ Meta Compiler Forward Reference Linking 06Jan86gemLINK-BACKWARDS Create a linked list of unresolved forward references. RESOLVED? Return non-zero if the word is already resolved. FORWARD-CODE If a forward reference is resolved, compile code else link it FORWARD: Defines an explicit forward reference. Initializes it to be unresolved. \ Create Headers in Target Image 06Jan86gemWIDTH The maximum length of the names in the Target LAST-T Points to the name of the most recent Target word CONTEXT-T Not really used, unless DEFINITIONS follows CURRENT-T Points to the Target vocabularies thread pointers. HASH Each name is linked into 1 of 4 threads to improve speed HEADER Create a header in the Target Dictionary. If WIDTH is zero, then no heads are created. HEADER in the Meta Compiler behaves the same as CREATE does in ordinary Forth. It makes a header out of the next word in the input stream, and fixes up all of the appropriate pointers to link it into the Target Dictionary. \ Meta Compiler Create Target Image 06Jan86gemTARGET-CREATE Create a Target Header and an entry in the symbol table. It is initialized to already resolved, so it compiles itself. RECREATE Same as TARGET-CREATE, but don't advance the input stream. CODE Set up for a low level word. As this is indirect threaded code, the code field points to the parameter field. END-CODE Terminate a low level word. Not required but tidy to have. \ Force compilation of target & forward words 06Jan86gem'T Look up the next word in the input stream only in the TARGET vocabulary, disturbing nothing else. [TARGET] Force compilation of a TARGET word, regardless of CONTEXT 'F Look up the next word in the input stream only in the FORWARD vocabulary, disturbing nothing else. [FORWARD] Force compilation of a FORWARD word, regardless of CONTEXT \ Meta Compiler Branching & Defining Words 06Jan86gemT: Used for special case compiling words. TRANSITION is normally searched before TARGET. Acts just like a : def. T; Terminate a word defined by T: DIGIT? Returns true if the character is a digit in current base. PUNCT? Returns true if the character is a valid puntucation character for numbers, such as leading - or decimal point. NUMERIC? Returns true if the string is a valid number in the current base. Note that a special test is made to make sure at least one digit is present. This prevents - from being a number. \ Meta Compiler Transition Words 06Jan86gem( Inherit ( from host for comments. (S Inherit (S from host for comments. \ Inherit \ from host for comments. STRING,-T Scan the input stream for a " delimited text and compile it. <(.")> Run time forward reference for code compiled by ." ." Compile the unknown run time code, followed by the string. <(")> Run time forward reference for code compiled by " " Compile unknown run time code, followed by string. <(ABORT")> Run time forward ref. for code compiled by ABORT" ABORT" Compile the unknown run time code, followed by the string. \ Meta Compiler Transition Words 06Jan86gem<VARIABLE> Forward reference for run time of CREATE & VARIABLE CREATE Create a target word whose run time is the run time for VARIABLE. Also create a host word to rreturn Target Here addr VARIABLE Make a variable in the Target Image. <DEFER> Forward reference for run time of DEFER DEFER An execution vector in the Target System. \ Meta Compiler Transition Words 06Jan86gem#USER-T Counts the number of user variables defined so far. ALLOT Allocate space in the USER area. <USER-VARIABLE> Forward reference for run time of USER vars. VARIABLE Create a User variable, which is task local. <USER-DEFER> Forward reference for run time of USER vectors DEFER Create a task local execution vector. \ Meta Compiler Transition Words 06Jan86gemVOC-LINK-T Links defined Vocabularies together. <VOCABULARY> Forward reference for run time of VOCABULARY VOCABULARY Create a target word that behaves like a vocabulary. Only one target vocabulary can contain definitions in this meta compiler, but several can be defined. IMMEDIATE If heads are compiled, flip the Target IMMEDIATE bit. \ Meta Compiler Transition Words 06Jan86gem<(;USES)> Forward reference for code compiled by ;USES STATE-T True if compiling inside : def. False if outside. ;USES This is a new syntax that can be used to compile a code field whose code already exists. Similar to ;CODE [COMPILE] Compile a TARGET word rather than execute its TRANSITION counterpart. <(IS)> Forward reference for run time of IS IS Compiles the unknown code field of <(IS)> IS The Meta Version of IS actually does the patch. \ Display an unformatted Symbol Table 06Jan86gem.SYMBOLS Print a primitive unformatted symbol table on the display. This is very useful if you ever need to debug with DDT, you have no idea where the addresses are. You can make it pretty if you like. \ Meta Compiler Resolve Forward References 06Jan86gem.UNRESOLVED Display all the words in the FORWARD vocabulary that have not already been resolved. You had better resolve them before saving a system, or else they will surely crash when you execute them. FIND-UNRESOLVED Search for a word in the FORWARD vocabulary and return status RESOLVE Run through the linked list of forward reference and resolve each of the with the given address. RESOLVES The user interface for resolving forward references. Used as follows: ' resolution-name RESOLVES forward-name \ Interpretive words for Meta 06Jan86gemH: Save a version of old : for later. Will be redefined. ' How ' should behave during Target Compilation. , How , should behave during Target Compilation. C, How C, should behave during Target Compilation. HERE How HERE should behave during Target Compilation. ALLOT How ALLOT should behave during Target Compilation. DEFINITIONS How DEFINITIONS should behave when interpreted. \ Meta Compiler Resolve Forward References 06Jan86gem.UNRESOLVED
